home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / FRACTION.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  5.0 KB  |  287 lines
  1. 10  ' **********************
  2. 20  ' **     FRACTION     **
  3. 30  ' **********************
  4. 40  '
  5. 50  CLEAR
  6. 60  SCREEN 0,0,0,0
  7. 70  CLS
  8. 80  KEY OFF
  9. 90  DEFDBL A-Z
  10. 100  LOCATE 1,28
  11. 110  PRINT "* * *  FRACTIONS  * * *
  12. 120  LOCATE 3,1
  13. 130  PRINT "Functions for two fractions ...
  14. 140  PRINT
  15. 150  PRINT TAB(22)"F1.   Fraction 1   +   Fraction 2
  16. 160  PRINT TAB(22)"F2.   Fraction 1   -   Fraction 2
  17. 170  PRINT TAB(22)"F3.   Fraction 1   *   Fraction 2
  18. 180  PRINT TAB(22)"F4.   Fraction 1   /   Fraction 2
  19. 190  PRINT
  20. 200  PRINT "Functions of two numbers ...
  21. 210  PRINT
  22. 220  PRINT TAB(22)"F5.   Greatest common divisor
  23. 230  PRINT TAB(22)"F6.   Least common multiple
  24. 240  PRINT TAB(22)"F7.   Reduction to lowest terms
  25. 250  PRINT
  26. 260  PRINT "Function of one number ...
  27. 270  PRINT
  28. 280  PRINT TAB(22)"F8.   Decimal to fraction approximation
  29. 290  PRINT TAB(22)"F9.   Fraction to decimal conversion
  30. 300  PRINT
  31. 310  PRINT
  32. 320  PRINT TAB(22)"F10.  Quit
  33. 330  LOCATE 25,22
  34. 340  PRINT "PRESS ANY SPECIAL FUNCTION KEY";
  35. 350  ON KEY(1) GOSUB 620
  36. 360  ON KEY(2) GOSUB 730
  37. 370  ON KEY(3) GOSUB 840
  38. 380  ON KEY(4) GOSUB 950
  39. 390  ON KEY(5) GOSUB 1060
  40. 400  ON KEY(6) GOSUB 1180
  41. 410  ON KEY(7) GOSUB 1300
  42. 420  ON KEY(8) GOSUB 1420
  43. 430  ON KEY(9) GOSUB 1790
  44. 440  ON KEY(10) GOSUB 1920
  45. 450  KEY(1) ON
  46. 460  KEY(2) ON
  47. 470  KEY(3) ON
  48. 480  KEY(4) ON
  49. 490  KEY(5) ON
  50. 500  KEY(6) ON
  51. 510  KEY(7) ON
  52. 520  KEY(8) ON
  53. 530  KEY(9) ON
  54. 540  KEY(10) ON
  55. 550  '
  56. 560  WHILE QUIT = NOT.YET
  57. 570  KEY.BUFFER.CLEAR$ = INKEY$
  58. 580  WEND
  59. 590  CLS
  60. 600  END
  61. 610  '
  62. 620  ' F1 Subroutine
  63. 630  FUN$ = "+"
  64. 640  SCREEN 0,0,1,1
  65. 650  GOSUB 1970
  66. 660  N = N1 * D2 + N2 * D1
  67. 670  D = D1 * D2
  68. 680  GOSUB 2400
  69. 690  GOSUB 2510
  70. 700  SCREEN 0,0,0,0
  71. 710  RETURN
  72. 720  '
  73. 730  ' F2 Subroutine
  74. 740  FUN$ = "-"
  75. 750  SCREEN 0,0,1,1
  76. 760  GOSUB 1970
  77. 770  N = N1 * D2 - N2 * D1
  78. 780  D = D1 * D2
  79. 790  GOSUB 2400
  80. 800  GOSUB 2510
  81. 810  SCREEN 0,0,0,0
  82. 820  RETURN
  83. 830  '
  84. 840  ' F3 Subroutine
  85. 850  FUN$ = "*"
  86. 860  SCREEN 0,0,1,1
  87. 870  GOSUB 1970
  88. 880  N = N1 * N2
  89. 890  D = D1 * D2
  90. 900  GOSUB 2400
  91. 910  GOSUB 2510
  92. 920  SCREEN 0,0,0,0
  93. 930  RETURN
  94. 940  '
  95. 950  ' F4 Subroutine
  96. 960  FUN$ = "/"
  97. 970  SCREEN 0,0,1,1
  98. 980  GOSUB 1970
  99. 990  N = N1 * D2
  100. 1000  D = D1 * N2
  101. 1010  GOSUB 2400
  102. 1020  GOSUB 2510
  103. 1030  SCREEN 0,0,0,0
  104. 1040  RETURN
  105. 1050  '
  106. 1060  ' F5 Subroutine
  107. 1070  SCREEN 0,0,1,1
  108. 1080  CLS
  109. 1090  LOCATE 7,14
  110. 1100  INPUT "Greatest common divisor.  Enter 'A,B' ";A,B
  111. 1110  GOSUB 2740
  112. 1120  LOCATE 14,14
  113. 1130  PRINT "Greatest common divisor is ";GCD
  114. 1140  GOSUB 2670
  115. 1150  SCREEN 0,0,0,0
  116. 1160  RETURN
  117. 1170  '
  118. 1180  ' F6 Subroutine
  119. 1190  SCREEN 0,0,1,1
  120. 1200  CLS
  121. 1210  LOCATE 7,14
  122. 1220  INPUT "Least common multiple.  Enter 'A,B' ";A,B
  123. 1230  GOSUB 2820
  124. 1240  LOCATE 14,14
  125. 1250  PRINT "Least common multiple is ";LCM
  126. 1260  GOSUB 2670
  127. 1270  SCREEN 0,0,0,0
  128. 1280  RETURN
  129. 1290  '
  130. 1300  ' F7 Subroutine
  131. 1310  SCREEN 0,0,1,1
  132. 1320  CLS
  133. 1330  LOCATE 7,14
  134. 1340  INPUT "Reduce to lowest terms.  Enter 'A,B' ";N,D
  135. 1350  GOSUB 2400
  136. 1360  LOCATE 14,14
  137. 1370  PRINT "Reduced to lowest terms =   ";N;"  ";D
  138. 1380  GOSUB 2670
  139. 1390  SCREEN 0,0,0,0
  140. 1400  RETURN
  141. 1410  '
  142. 1420  ' F8 Subroutine
  143. 1430  SCREEN 0,0,1,1
  144. 1440  CLS
  145. 1450  LOCATE 7,9
  146. 1460  INPUT "Decimal to fraction conversion.  Enter X ";X
  147. 1470  PRINT
  148. 1480  PRINT TAB(14)"Fraction"TAB(47)"Error from X"
  149. 1490  PRINT TAB(13)"-------------"TAB(44)"-----------------"
  150. 1500  T1 = 1
  151. 1510  T2 = 1
  152. 1520  T3 = 1
  153. 1530  T4 = INT(X)
  154. 1540  T5 = X - T4
  155. 1550  T7 = 0
  156. 1560  T8 = 0
  157. 1570  DIF = 1
  158. 1580    WHILE ABS(DIF) > 0
  159. 1590    NUM = T3 * T4 + T7
  160. 1600    DEN = T4 * T8 + T2
  161. 1610    DIF = NUM / DEN - X
  162. 1620    IF T5 = 0 THEN 1710
  163. 1630    T4 = INT(T1/T5)
  164. 1640    T6 = T5
  165. 1650    T5 = T1 - T4 * T5
  166. 1660    T1 = T6
  167. 1670    T7 = T3
  168. 1680    T3 = NUM
  169. 1690    T2 = T8
  170. 1700    T8 = DEN
  171. 1710    PRINT TAB(14)NUM;" / ";DEN;
  172. 1720    PRINT TAB(49);
  173. 1730    PRINT USING "+#.#^^^^" ;DIF
  174. 1740    WEND
  175. 1750  GOSUB 2670
  176. 1760  SCREEN 0,0,0,0
  177. 1770  RETURN
  178. 1780  '
  179. 1790  ' F9 Subroutine
  180. 1800  SCREEN 0,0,1,1
  181. 1810  CLS
  182. 1820  LOCATE 7,1
  183. 1830  PRINT "Enter a fraction,
  184. 1840  LINE INPUT "'numerator/denominator' ...";FR$
  185. 1850  GOSUB 2230
  186. 1860  LOCATE 12,30
  187. 1870  PRINT "= ";NF/DF
  188. 1880  GOSUB 2670
  189. 1890  SCREEN 0,0,0,0
  190. 1900  RETURN
  191. 1910  '
  192. 1920  ' F10 Subroutine
  193. 1930  QUIT = 1
  194. 1940  RETURN
  195. 1950  '
  196. 1960  ' Subroutine, input two fractions
  197. 1970  CLS
  198. 1980  LOCATE 7,1
  199. 1990  PRINT "Enter first fraction,
  200. 2000  LINE INPUT "'numerator/denominator' ...";FR$
  201. 2010  IF INSTR(FR$,".") = 0 THEN 2050
  202. 2020  BEEP
  203. 2030  PRINT TAB(40)"No decimal points please"
  204. 2040  GOTO 2000
  205. 2050  GOSUB 2230
  206. 2060  N1 = NF
  207. 2070  D1 = DF
  208. 2080  PRINT
  209. 2090  PRINT TAB(17)FUN$
  210. 2100  PRINT
  211. 2110  PRINT "Enter second fraction,
  212. 2120  LINE INPUT "'numerator/denominator' ...";FR$
  213. 2130  IF INSTR(FR$,".") = 0 THEN 2170
  214. 2140  BEEP
  215. 2150  PRINT TAB(40)"No decimal points please"
  216. 2160  GOTO 2120
  217. 2170  GOSUB 2230
  218. 2180  N2 = NF
  219. 2190  D2 = DF
  220. 2200  RETURN
  221. 2210  '
  222. 2220  ' Subroutine, FR$ to NF and DF
  223. 2230  IP = INSTR(FR$,",")
  224. 2240  IF IP = 0 THEN 2270
  225. 2250  MID$(FR$,IP,1) = "/"
  226. 2260  GOTO 2230
  227. 2270  IP = INSTR(FR$,"/")
  228. 2280  IF IP THEN 2310
  229. 2290  FR$ = FR$ + "/1"
  230. 2300  GOTO 2270
  231. 2310  NF = VAL(LEFT$(FR$,IP))
  232. 2320  DF = VAL(MID$(FR$,IP+1))
  233. 2330  IF INSTR(FR$,"N") THEN NF = N
  234. 2340  IF INSTR(FR$,"n") THEN NF = N
  235. 2350  IF INSTR(FR$,"D") THEN DF = D
  236. 2360  IF INSTR(FR$,"d") THEN DF = D
  237. 2370  RETURN
  238. 2380  '
  239. 2390  ' Subroutine, reduction of N and D to lowest terms
  240. 2400  A = N
  241. 2410  B = D
  242. 2420  GOSUB 2740
  243. 2430  N = N / GCD
  244. 2440  D = D / GCD
  245. 2450  IF SGN(D) > -1 THEN 2480
  246. 2460  N = -N
  247. 2470  D = -D
  248. 2480  RETURN
  249. 2490  '
  250. 2500  ' Subroutine, output of two fraction problem results
  251. 2510  CLS
  252. 2520  LOCATE 7,27
  253. 2530  PRINT N1;"/";D1;"  ";FUN$;"  ";N2;"/";D2
  254. 2540  LOCATE 10,30
  255. 2550  IF D <> 1 THEN 2580
  256. 2560  PRINT "=  ";N
  257. 2570  GOTO 2630
  258. 2580  PRINT "=  ";N;"/";D
  259. 2590  IF ABS(N) < D THEN 2630
  260. 2600  LOCATE 12,30
  261. 2610  NUM = VAL(LEFT$(STR$(N/D),INSTR(STR$(N/D),".")))
  262. 2620  PRINT "=  ";NUM;" and ";N - NUM * D;"/";D
  263. 2630  GOSUB 2670
  264. 2640  RETURN
  265. 2650  '
  266. 2660  ' Subroutine, wait until user wants to proceed
  267. 2670  LOCATE 25,25
  268. 2680  PRINT "PRESS SPACE BAR TO CONTINUE";
  269. 2690  K$ = INKEY$
  270. 2700  IF K$ <> " " THEN 2690
  271. 2710  RETURN
  272. 2720  '
  273. 2730  ' Subroutine, greatest common divisor of A and B
  274. 2740  TEMP = A - B * INT(A/B)
  275. 2750  A = B
  276. 2760  B = TEMP
  277. 2770  IF TEMP THEN 2740
  278. 2780  GCD = A
  279. 2790  RETURN
  280. 2800  '
  281. 2810  ' Subroutine, least common multiple of A and B
  282. 2820  A2 = A
  283. 2830  B2 = B
  284. 2840  GOSUB 2740
  285. 2850  LCM = ABS(A2 * B2 / GCD)
  286. 2860  RETURN
  287.